home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / dev / m2 / ModGen.lha / ModGen / Source / MGgui.mod < prev    next >
Text File  |  1995-04-17  |  12KB  |  354 lines
  1. IMPLEMENTATION MODULE MGgui;
  2.  
  3. (*
  4.  *  Source generated with ModGen V1.0 (17.4.95) by Frank Lömker
  5.  *  ModGen is based on OG V37.11 by Thomas Igracki
  6.  *  OG is based on GenOberon V1.0 by Kai Bolay & Jan van den Baard
  7.  *
  8.  *  GUI generated with GadToolsBox by Jan van den Baard
  9.  *  GUI designed by : Frank Lömker
  10.  *)
  11.  
  12. IMPORT
  13.   I:=Intuition, gt:=GadTools, u:=Utility, g:=Graphics, e:=Exec, C:=Classes, gf:=GetFile, gfx:=GfxMacros, m2:=M2Lib, y:=SYSTEM;
  14.  
  15. VAR
  16.   MGGetImage: C.ObjectPtr;
  17.   FontX, FontY: INTEGER;
  18.   OffX, OffY: INTEGER;
  19.  
  20. TYPE From0LArray = ARRAY [0..2] OF y.STRING;
  21. VAR From0Labels : From0LArray;
  22. VAR
  23.   MGIText: ARRAY [0..0] OF I.IntuiText;
  24. TYPE MGGTypesArray = ARRAY [0..MGCNT-1] OF INTEGER;
  25. VAR MGGTypes : MGGTypesArray;
  26. TYPE MGNGadArray = ARRAY [0..MGCNT-1] OF gt.NewGadget;
  27. VAR MGNGad : POINTER TO MGNGadArray;
  28. TYPE MGGTagsArray = ARRAY [0..  77] OF y.ADDRESS;
  29. VAR MGGTags : POINTER TO MGGTagsArray;
  30.  
  31. PROCEDURE ComputeX (value: INTEGER): INTEGER;
  32. BEGIN
  33.   RETURN ((FontX * value) + 4 ) DIV 8;
  34. END ComputeX;
  35.  
  36. PROCEDURE ComputeY (value: INTEGER): INTEGER;
  37. BEGIN
  38.   RETURN ((FontY * value)  + 4 ) DIV 8;
  39. END ComputeY;
  40.  
  41. PROCEDURE ComputeFont (width, height: INTEGER);
  42. VAR x:INTEGER;
  43. BEGIN
  44.   Font := y.ADR (Attr);
  45.   Font^.ta_Name := Scr^.RastPort.Font^.tf_Message.mn_Node.ln_Name;
  46.   FontY := Scr^.RastPort.Font^.tf_YSize;
  47.   Font^.ta_YSize := FontY;
  48.   FontX := Scr^.RastPort.Font^.tf_XSize;
  49.   IF g.FPB_PROPORTIONAL IN Scr^.RastPort.Font^.tf_Flags THEN
  50.     x:=(g.TextLength (y.ADR(Scr^.RastPort),y.ADR("ABCDHKOP"),8)+7) DIV 8;
  51.     IF x>=FontX THEN FontX:=x;
  52.                 ELSE FontX:=(FontX+x) DIV 2; END;
  53.   END;
  54.  
  55.   OffX := Scr^.WBorLeft;
  56.   OffY := Scr^.RastPort.TxHeight + Scr^.WBorTop + 1;
  57.  
  58.   IF (width # 0) AND (height # 0) AND
  59.      (ComputeX (width) + OffX + Scr^.WBorRight > Scr^.Width) OR
  60.      (ComputeY (height) + OffY + Scr^.WBorBottom > Scr^.Height) THEN
  61.     Font := y.ADR (Topaz80);
  62.     FontY := 8; FontX := 8;
  63.   END;
  64. END ComputeFont;
  65.  
  66. PROCEDURE SetupScreen (pub: y.STRING): INTEGER;
  67. BEGIN
  68.   Scr := I.LockPubScreen (pub);
  69.   IF Scr = NIL THEN RETURN 1 END;
  70.  
  71.   ComputeFont (0, 0);
  72.  
  73.   VisualInfo := gt.GetVisualInfoA (Scr, NIL);
  74.   IF VisualInfo = NIL THEN RETURN 2 END;
  75.  
  76.   IF gf.GetFileClass = NIL THEN RETURN 4 END;
  77.  
  78.   RETURN 0;
  79. END SetupScreen;
  80.  
  81. PROCEDURE CloseDownScreen;
  82. BEGIN
  83.   IF VisualInfo # NIL THEN
  84.     gt.FreeVisualInfo (VisualInfo);
  85.     VisualInfo := NIL;
  86.   END;
  87.   IF Scr # NIL THEN
  88.     I.UnlockPubScreen (NIL, Scr);
  89.     Scr := NIL;
  90.   END;
  91. END CloseDownScreen;
  92.  
  93. PROCEDURE DrawRast (win: I.WindowPtr);
  94. TYPE PattType = ARRAY [0..1] OF CARDINAL;
  95. VAR backPatt : PattType;
  96. BEGIN
  97.   backPatt := [0AAAAH,05555H];
  98.   g.SetAPen (win^.RPort, 2);
  99.   gfx.SetAfPt (win^.RPort, y.ADR(backPatt),1);
  100.   IF I.GIMMEZEROZERO <= win^.Flags THEN
  101.     g.RectFill(win^.RPort,0,0,win^.GZZWidth,win^.GZZHeight);
  102.   ELSE
  103.     g.RectFill(win^.RPort, win^.BorderLeft,win^.BorderTop,
  104.                win^.Width-win^.BorderLeft-1, win^.Height-win^.BorderBottom-1);
  105.   END;
  106.   gfx.SetAfPt (win^.RPort, NIL,0);
  107. END DrawRast;
  108.  
  109. PROCEDURE MGRender;
  110. VAR rp:g.RastPortPtr;
  111.     sx,sy:INTEGER;
  112. BEGIN
  113.  IF MGWnd^.Height-MGWnd^.BorderBottom-1-MGWnd^.BorderTop>0 THEN
  114.   DrawRast (MGWnd);
  115.   rp:=MGWnd^.RPort;
  116.   ComputeFont (MGWidth, MGHeight);
  117.  
  118.   g.SetAPen (rp,0);
  119.   sx:=OffX+ComputeX(7); sy:=OffY+ComputeY(4);
  120.   g.RectFill (rp, sx, sy, sx+ComputeX(302)-2, sy+ComputeY(52)-2 );
  121.   sx:=OffX+ComputeX(338); sy:=OffY+ComputeY(23);
  122.   g.RectFill (rp, sx, sy, sx+ComputeX(159)-2, sy+ComputeY(93)-2 );
  123.   sx:=OffX+ComputeX(319); sy:=OffY+ComputeY(4);
  124.   g.RectFill (rp, sx, sy, sx+ComputeX(197)-2, sy+ComputeY(121)-2 );
  125.   sx:=OffX+ComputeX(7); sy:=OffY+ComputeY(61);
  126.   g.RectFill (rp, sx, sy, sx+ComputeX(302)-2, sy+ComputeY(121)-2 );
  127.   g.SetAPen (rp,1);
  128.   gt.DrawBevelBox (rp, OffX+ComputeX(7), OffY+ComputeY(4),
  129.                        ComputeX(302), ComputeY(52),
  130.                    gt.GT_VisualInfo, VisualInfo, gt.GTBB_Recessed, TRUE,u.TAG_DONE);
  131.   gt.DrawBevelBox (rp, OffX+ComputeX(338), OffY+ComputeY(23),
  132.                        ComputeX(159), ComputeY(93),
  133.                    gt.GT_VisualInfo, VisualInfo, u.TAG_DONE);
  134.   gt.DrawBevelBox (rp, OffX+ComputeX(319), OffY+ComputeY(4),
  135.                        ComputeX(197), ComputeY(121),
  136.                    gt.GT_VisualInfo, VisualInfo, gt.GTBB_Recessed, TRUE,u.TAG_DONE);
  137.   gt.DrawBevelBox (rp, OffX+ComputeX(7), OffY+ComputeY(61),
  138.                        ComputeX(302), ComputeY(121),
  139.                    gt.GT_VisualInfo, VisualInfo, gt.GTBB_Recessed, TRUE,u.TAG_DONE);
  140.  
  141.   MGIText := [
  142.     [1, 0, g.JAM1,0 ,OffY + ComputeY (13) - Font^.ta_YSize DIV 2, Font,
  143.       "Preferences", NIL] ];
  144.   MGIText[0].LeftEdge:= OffX + ComputeX (421) - (I.IntuiTextLength (y.ADR(MGIText[0])) DIV 2);
  145.   I.PrintIText (rp, y.ADR(MGIText[0]), 0, 0);
  146.  END;
  147.  
  148.   I.RefreshGList (MGGList, MGWnd, NIL, -1);
  149.   gt.GT_RefreshWindow (MGWnd, NIL);
  150.  
  151. END MGRender;
  152.  
  153. PROCEDURE CreateMGGadgets (): INTEGER;
  154. VAR
  155.   ng: gt.NewGadget;
  156.   gad: I.GadgetPtr;
  157.   lc, tc: INTEGER;
  158. BEGIN
  159.   ComputeFont (MGWidth, MGHeight);
  160.  
  161.   MGGetImage := C.NewObject (gf.GetFileClass,NIL,gt.GT_VisualInfo,VisualInfo,
  162.                                    C.IA_Width,ComputeX(20),C.IA_Height,ComputeY(14),u.TAG_DONE);
  163.   IF MGGetImage = NIL THEN RETURN 7 END;
  164.  
  165.   gad := gt.CreateContext (MGGList);
  166.   IF gad = NIL THEN RETURN 1 END;
  167.  
  168.   lc := 0; tc := 0;
  169.   WHILE lc < MGCNT DO
  170.     ng := MGNGad^[lc];
  171.     ng.ng_VisualInfo := VisualInfo;
  172.     ng.ng_TextAttr   := Font;
  173.     ng.ng_LeftEdge   := OffX + ComputeX (ng.ng_LeftEdge);
  174.     ng.ng_TopEdge    := OffY + ComputeY (ng.ng_TopEdge);
  175.     ng.ng_Width      := ComputeX (ng.ng_Width);
  176.     ng.ng_Height     := ComputeY (ng.ng_Height);
  177.  
  178.     gad := gt.CreateGadgetA (MGGTypes[lc], gad, ng, y.ADR (MGGTags^[tc]));
  179.     IF gad = NIL THEN RETURN 2 END;
  180.     MGGadgets[lc] := gad;
  181.  
  182.     IF MGGTypes[lc] = gt.GENERIC_KIND THEN
  183.       INCL (gad^.Flags, I.GADGIMAGE+I.GADGHIMAGE);
  184.       IF u.FindTagItem (C.GA_Disabled,y.ADR (MGGTags^[tc]))#NIL THEN
  185.         INCL (gad^.Flags, I.GADGDISABLED);
  186.       END;
  187.       INCL (gad^.Activation, I.RELVERIFY);
  188.       gad^.GadgetRender := MGGetImage;
  189.       gad^.SelectRender := MGGetImage;
  190.     END; (* IF *)
  191.  
  192.     WHILE MGGTags^[tc] # u.TAG_DONE DO INC (tc, 2) END;
  193.     INC (tc);
  194.  
  195.     INC (lc);
  196.   END; (* WHILE *)
  197.  
  198.   RETURN 0;
  199. END CreateMGGadgets;
  200.  
  201. PROCEDURE OpenMGWindow (createGads: BOOLEAN): INTEGER;
  202. VAR ret, wleft, wtop, ww, wh: INTEGER;
  203. BEGIN
  204.   wleft := MGLeft; wtop := MGTop;
  205.  
  206.   ComputeFont (MGWidth, MGHeight);
  207.  
  208.   ww := ComputeX (MGWidth);
  209.   wh := ComputeY (MGHeight);
  210.  
  211.   IF wleft + ww + OffX + Scr^.WBorRight > Scr^.Width THEN
  212.     wleft := Scr^.Width - ww;
  213.   END;
  214.   IF wtop + wh + OffY + Scr^.WBorBottom > Scr^.Height THEN
  215.     wtop := Scr^.Height - wh;
  216.   END;
  217.  
  218.   IF createGads THEN
  219.     ret := CreateMGGadgets(); IF ret # 0 THEN RETURN ret END;
  220.   END;
  221.  
  222.   MGZoom[0] := MGLeft;
  223.   MGZoom[1] := MGTop;
  224.   MGZoom[2] := g.TextLength (y.ADR (Scr^.RastPort), y.ADR("ModGen V1.0"), 11) + 80;
  225.   MGZoom[3] := Scr^.WBorTop + Scr^.RastPort.TxHeight + 1;
  226.  
  227.   MGWnd := I.OpenWindowTags ( NIL,
  228.                 I.WA_Left,          wleft,
  229.                 I.WA_Top,           wtop,
  230.                 I.WA_InnerWidth,    ww,
  231.                 I.WA_InnerHeight,   wh,
  232.                 I.WA_IDCMP,         gt.LISTVIEWIDCMP+gt.BUTTONIDCMP+gt.MXIDCMP+LONGSET(gt.TEXTIDCMP)+gt.CHECKBOXIDCMP+gt.STRINGIDCMP+I.GADGETUP+
  233.                     I.CLOSEWINDOW+I.VANILLAKEY+I.REFRESHWINDOW,
  234.                 I.WA_Flags,         I.WINDOWDRAG+I.WINDOWDEPTH+I.WINDOWCLOSE+I.ACTIVATE+I.RMBTRAP,
  235.                 I.WA_NewLookMenus,  TRUE,
  236.                 I.WA_Title,         "ModGen V1.0",
  237.                 I.WA_ScreenTitle,   "ModGen V1.0 by Frank Lömker, based on OG and GenOberon",
  238.                 I.WA_PubScreen,     Scr,
  239.                 I.WA_Zoom,          y.ADR (MGZoom),
  240.                 I.WA_AutoAdjust,    TRUE,
  241.                 I.WA_PubScreenFallBack, TRUE,
  242.                 u.TAG_DONE);
  243.   IF MGWnd = NIL THEN RETURN 20 END;
  244.  
  245.   ret:=I.AddGList (MGWnd,MGGList,-1,-1,NIL);
  246.   MGRender;
  247.  
  248.   RETURN 0;
  249. END OpenMGWindow;
  250.  
  251. PROCEDURE CloseMGWindow;
  252. BEGIN
  253.   IF MGWnd # NIL THEN
  254.     I.CloseWindow (MGWnd);
  255.     MGWnd := NIL;
  256.   END;
  257.   IF MGGList # NIL THEN
  258.     gt.FreeGadgets (MGGList);
  259.     MGGList := NIL;
  260.   END;
  261.   IF MGGetImage # NIL THEN
  262.     C.DisposeObject (MGGetImage);
  263.     MGGetImage := NIL;
  264.   END;
  265. END CloseMGWindow;
  266.  
  267. PROCEDURE GetMem (size:LONGINT):y.ADDRESS;
  268. VAR ptr:y.ADDRESS;
  269. BEGIN
  270.   ptr:=m2.malloc (size);
  271.   IF ptr=NIL THEN m2._ErrorReq ("Not enought Memory"," "); END;
  272.   RETURN ptr;
  273. END GetMem;
  274.  
  275. BEGIN
  276.   Topaz80:=[y.ADR ("topaz.font"),8];
  277.   From0Labels := [
  278.     "_from",
  279.     "_to",
  280.     NIL];
  281.   MGGTypes := [
  282.     gt.LISTVIEW_KIND,
  283.     gt.BUTTON_KIND,
  284.     gt.BUTTON_KIND,
  285.     gt.BUTTON_KIND,
  286.     gt.MX_KIND,
  287.     gt.TEXT_KIND,
  288.     gt.TEXT_KIND,
  289.     gt.CHECKBOX_KIND,
  290.     gt.CHECKBOX_KIND,
  291.     gt.CHECKBOX_KIND,
  292.     gt.CHECKBOX_KIND,
  293.     gt.BUTTON_KIND,
  294.     gt.BUTTON_KIND,
  295.     gt.STRING_KIND,
  296.     gt.STRING_KIND,
  297.     gt.GENERIC_KIND,
  298.     gt.GENERIC_KIND,
  299.     gt.CHECKBOX_KIND,
  300.     gt.STRING_KIND,
  301.     gt.GENERIC_KIND,
  302.     gt.CHECKBOX_KIND ];
  303.   MGNGad := GetMem (SIZE(MGNGadArray));
  304.   MGNGad^ := [
  305.     [16, 77, 286, 72, "Windows", NIL, GDWindows, gt.PLACETEXT_ABOVE],
  306.     [327, 131, 84, 14, "_All", NIL, GDAll, gt.PLACETEXT_IN],
  307.     [374, 169, 84, 14, "Quit", NIL, GDQuit, gt.PLACETEXT_IN],
  308.     [327, 150, 84, 14, "_Selected", NIL, GDSelect, gt.PLACETEXT_IN],
  309.     [59, 150, 17, 9, NIL, NIL, GDFrom, gt.PLACETEXT_LEFT],
  310.     [90, 148, 212, 14, NIL, NIL, GDTfrom],
  311.     [90, 164, 212, 14, NIL, NIL, GDTto],
  312.     [352, 29, 26, 11, "Gen _OpenFont", NIL, GDFont, gt.PLACETEXT_RIGHT],
  313.     [352, 43, 26, 11, "_Use SysFont", NIL, GDSys, gt.PLACETEXT_RIGHT],
  314.     [352, 57, 26, 11, "_Raster", NIL, GDRaster, gt.PLACETEXT_RIGHT],
  315.     [352, 71, 26, 11, "Under_mouse", NIL, GDMouse, gt.PLACETEXT_RIGHT],
  316.     [424, 131, 84, 14, "Sa_vePref", NIL, GDSave, gt.PLACETEXT_IN],
  317.     [424, 150, 84, 14, "A_bout", NIL, GDAbout, gt.PLACETEXT_IN],
  318.     [72, 8, 207, 14, "Sour_ce", NIL, GDSource, gt.PLACETEXT_LEFT],
  319.     [72, 23, 207, 14, "_Dest", NIL, GDDest, gt.PLACETEXT_LEFT],
  320.     [282, 8, 20, 14, NIL, NIL, GDFsource],
  321.     [282, 23, 20, 14, NIL, NIL, GDFdest],
  322.     [352, 99, 26, 11, "_Icon", NIL, GDIcon, gt.PLACETEXT_RIGHT],
  323.     [72, 38, 207, 14, "Scr_een", NIL, GDScreen, gt.PLACETEXT_LEFT],
  324.     [282, 38, 20, 14, NIL, NIL, GDFscreen],
  325.     [352, 85, 26, 11, "Share Msg_Port", NIL, GDPort, gt.PLACETEXT_RIGHT] ];
  326.   MGGTags := GetMem (SIZE(MGGTagsArray));
  327.   MGGTags^ := [
  328.     u.TAG_DONE,
  329.     y.ADDRESS(gt.GT_Underscore), ORD ('_'), u.TAG_DONE,
  330.     u.TAG_DONE,
  331.     y.ADDRESS(gt.GT_Underscore), ORD ('_'), u.TAG_DONE,
  332.     y.ADDRESS(gt.GTMX_Labels), y.ADR (From0Labels[0]), y.ADDRESS(gt.GTMX_Spacing), 8, y.ADDRESS(gt.GTMX_Scaled), ORD(TRUE), y.ADDRESS(gt.GT_Underscore), ORD ('_'), u.TAG_DONE,
  333.     y.ADDRESS(gt.GTTX_Border), ORD(TRUE), u.TAG_DONE,
  334.     y.ADDRESS(gt.GTTX_Border), ORD(TRUE), u.TAG_DONE,
  335.     y.ADDRESS(gt.GTCB_Scaled), ORD(TRUE), y.ADDRESS(gt.GT_Underscore), ORD ('_'), u.TAG_DONE,
  336.     y.ADDRESS(gt.GTCB_Scaled), ORD(TRUE), y.ADDRESS(gt.GT_Underscore), ORD ('_'), u.TAG_DONE,
  337.     y.ADDRESS(gt.GTCB_Scaled), ORD(TRUE), y.ADDRESS(gt.GT_Underscore), ORD ('_'), u.TAG_DONE,
  338.     y.ADDRESS(gt.GTCB_Scaled), ORD(TRUE), y.ADDRESS(gt.GT_Underscore), ORD ('_'), u.TAG_DONE,
  339.     y.ADDRESS(gt.GT_Underscore), ORD ('_'), u.TAG_DONE,
  340.     y.ADDRESS(gt.GT_Underscore), ORD ('_'), u.TAG_DONE,
  341.     y.ADDRESS(gt.GTST_MaxChars), 256, y.ADDRESS(gt.GT_Underscore), ORD ('_'), u.TAG_DONE,
  342.     y.ADDRESS(gt.GTST_MaxChars), 256, y.ADDRESS(gt.GT_Underscore), ORD ('_'), u.TAG_DONE,
  343.     u.TAG_DONE,
  344.     u.TAG_DONE,
  345.     y.ADDRESS(gt.GTCB_Scaled), ORD(TRUE), y.ADDRESS(gt.GT_Underscore), ORD ('_'), u.TAG_DONE,
  346.     y.ADDRESS(gt.GTST_MaxChars), 256, y.ADDRESS(gt.GT_Underscore), ORD ('_'), u.TAG_DONE,
  347.     u.TAG_DONE,
  348.     y.ADDRESS(gt.GTCB_Scaled), ORD(TRUE), y.ADDRESS(gt.GT_Underscore), ORD ('_'), u.TAG_DONE ];
  349.   MGLeft := 48;
  350.   MGTop := 1;
  351.   MGWidth := 523;
  352.   MGHeight := 186;
  353. END MGgui.
  354.